home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / nfsrc21.zip / CLRSEL.PRG < prev    next >
Text File  |  1991-08-17  |  25KB  |  792 lines
  1. /*
  2.  * File......: ClrSel.PRG
  3.  * Author....: Dave Adams
  4.  * CIS ID....: 72037,2654
  5.  * Date......: $Date:   17 Aug 1991 15:05:22  $
  6.  * Revision..: $Revision:   1.2  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/clrsel.prv  $
  8.  * 
  9.  * This is an original work by Dave Adams and is placed in the
  10.  * public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   E:/nanfor/src/clrsel.prv  $
  16.  * 
  17.  *    Rev 1.2   17 Aug 1991 15:05:22   GLENN
  18.  * Don Caton made corrected some spelling errors in the doc
  19.  * 
  20.  *    Rev 1.1   15 Aug 1991 23:03:50   GLENN
  21.  * Forest Belt proofread/edited/cleaned up doc
  22.  * 
  23.  *    Rev 1.0   13 Jun 1991 15:21:46   GLENN
  24.  * Initial revision.
  25.  *
  26.  */
  27.  
  28.  
  29.  
  30. /*  $DOC$
  31.  *  $FUNCNAME$
  32.  *     FT_ClrSel()
  33.  *  $CATEGORY$
  34.  *     Menus/Prompts
  35.  *  $ONELINER$
  36.  *     User Selectable Colour Routine
  37.  *  $SYNTAX$
  38.  *     FT_ClrSel( <aClrData>, [ <lClrMode> ], [ <cTestChr> ]  -> aClrData
  39.  *  $ARGUMENTS$
  40.  *
  41.  *     <aClrData> is an array of subarrays, with each subarray containing
  42.  *        information about the colour settings.
  43.  *
  44.  *        The subarray has the following structure:
  45.  *
  46.  *         [1]  cName    is the name of this colour setting i.e. "Pick List"
  47.  *                 Maximum length is 20 bytes
  48.  *
  49.  *         [2]  cClrStr  is the current colour string
  50.  *                 Default is "W/N,N/W,N/N,N/N,N/W"
  51.  *
  52.  *                 If Setting type is "M" (Menu) the colours are...
  53.  *                    1.  Prompt Colour
  54.  *                    2.  Message Colour
  55.  *                    3.  HotKey Colour
  56.  *                    4.  LightBar Colour
  57.  *                    5.  LightBar HotKey Colour
  58.  *
  59.  *                 Note: While there are many ways to code the individual
  60.  *                    colour combinations,  they should be in the same
  61.  *                    format that gets returned from SETCOLOR(), so
  62.  *                    the defaults can be found in the colour palette.
  63.  *
  64.  *                    foreground [+] / background [*]
  65.  *                    i.e. "GR+/BG*, N/W*, N+/N, , W/N"
  66.  *
  67.  *         [3]  cType  is the type of colour setting
  68.  *                 Default is "W" (Window)
  69.  *
  70.  *                    T = Title     Only 1 colour element
  71.  *                    D = Desktop   Background colour and character
  72.  *                    M = Menu      For FT_Menuto() style menus
  73.  *                    W = Window    Windows with radio buttons
  74.  *                    G = Get       For use with @ SAY...
  75.  *                    B = Browse    For tBrowse() and *dbEdit()
  76.  *                    A = aChoice   Pick-lists etc...
  77.  *
  78.  *                 W/G/B/A are functionally the same but will provide
  79.  *                 a more appropriate test display.
  80.  *
  81.  *         [4]  cFillChar  is the character (for desktop background only)
  82.  *                 Default is CHR(177) "▒▒▒▒▒▒▒▒▒▒▒▒▒▒"
  83.  *
  84.  *
  85.  *     <lClrMode>   .T.  use colour palette
  86.  *                 .F.  use monochrome palette
  87.  *
  88.  *                 Default is the ISCOLOR() setting
  89.  *
  90.  *     <cTestChr>  2 Byte character string for colour test display
  91.  *
  92.  *                 Default is the CHR(254)+CHR(254)  "■■"
  93.  *
  94.  *  $RETURNS$
  95.  *     An array identical to the one passed, with new selected colours
  96.  *  $DESCRIPTION$
  97.  *       This function allows users to select their own colour combinations
  98.  *     for all the different types of screen I/O in a typical application.
  99.  *     This facilitates an easy implementation of Ted Means' replacement
  100.  *     of the  @..PROMPT/MENU TO found in the NanForum Toolkit.  If you are
  101.  *     not using FT_MENUTO(), you can specify "A" for setting type and have
  102.  *     a normal colour string returned.
  103.  *  $EXAMPLES$
  104.  *     LOCAL aClrs   := {}
  105.  *     LOCAL lColour := ISCOLOR()
  106.  *     LOCAL cChr    := CHR(254) + CHR(254)
  107.  *     
  108.  *     SET SCOREBOARD Off
  109.  *     SETBLINK( .F. )       // Allow bright backgrounds
  110.  *   
  111.  *     *.... a typical application might have the following different settings
  112.  *     *     normally these would be stored in a .dbf/.dbv
  113.  *     aClrs := {;
  114.  *        { "Desktop",        "N/BG",                         "D", "▒" }, ;
  115.  *        { "Title",          "N/W",                          "T"      }, ;
  116.  *        { "Top Menu",       "N/BG,N/W,W+/BG,W+/N,GR+/N",    "M"      }, ;
  117.  *        { "Sub Menu",       "W+/N*,GR+/N*,GR+/N*,W+/R,G+/R","M"      }, ;
  118.  *        { "Standard Gets",  "W/B,  W+/N,,, W/N",            "G"      }, ;
  119.  *        { "Nested Gets",    "N/BG, W+/N,,, W/N",            "G"      }, ;
  120.  *        { "Help",           "N/G,  W+/N,,, W/N",            "W"      }, ;
  121.  *        { "Error Messages", "W+/R*,N/GR*,,,N/R*",           "W"      }, ;
  122.  *        { "Database Query", "N/BG, N/GR*,,,N+/BG",          "B"      }, ;
  123.  *        { "Pick List",      "N/GR*,W+/B,,, BG/GR*",         "A"      }  ;
  124.  *              }
  125.  *   
  126.  *    aClrs := FT_ClrSel( aClrs, lColour, cChr )
  127.  *  $END$
  128.  */
  129.  
  130. /*
  131.  * File Contents
  132.  * 
  133.  *   FT_ClrSel( aClrs, lColour, cChr )         user selectable colour routine
  134.  *   _ftHiLite( nRow, nCol, cStr, nLen )       re-hilite an achoice prompt
  135.  *   _ftColours( aOpt, aClrPal, lColour )      control colour selection
  136.  *   _ftShowIt( aOpt )                         show a sample of the colours
  137.  *   _ftClrSel( aClrPal, cClr, nElem, aOpt)    pick a colour
  138.  *   _ftClrPut( cClrStr, nElem, cClr )         place a clr element into str
  139.  *   _ftDeskChar( aOpt )                       select desktop char
  140.  *   _ftChr2Arr( cString, cDelim )             parse string into array
  141.  *   _ftArr2Chr( aArray, cDelim )              create string from array
  142.  *   _ftShowPal( aClrPal, cChr )               paint palette on screen
  143.  *   _ftInitPal( aClrTab )                     create the palette
  144.  *   _ftIdentArr( aArray1, aArray2 )           compare array contents
  145.  *
  146.  */
  147.  
  148. /*
  149.  * Commentary
  150.  *
  151.  *  Thanks to Brian Loesgen for offering ideas and helping to tweak
  152.  *  the code.
  153.  *
  154.  *
  155.  */
  156.  
  157. *------------------------------------------------
  158. // Pre-processor stuff
  159.  
  160. #include "box.ch"
  161. #include "setcurs.ch"
  162. #include "inkey.ch"
  163.  
  164. #define C_NAME   1
  165. #define C_CLR    2
  166. #define C_TYPE   3
  167. #define C_CHAR   4
  168.  
  169. #translate Single( <t>, <l>, <b>, <r> ) =>;
  170.            @ <t>, <l>, <b>, <r> BOX B_SINGLE
  171.  
  172. #translate Double( <t>, <l>, <b>, <r> ) =>;
  173.            @ <t>, <l>, <b>, <r> BOX B_DOUBLE
  174.  
  175. #translate ClearS( <t>, <l>, <b>, <r> ) =>;
  176.            @ <t>, <l> CLEAR TO <b>, <r>
  177.  
  178. #translate BkGrnd( <t>, <l>, <b>, <r>, <c> ) =>;
  179.            DispBox( <t>, <l>, <b>, <r>, REPLICATE(<c>,9) )
  180.  
  181. #command DEFAULT <p> TO <val> [, <pn> TO <valn> ]  =>;
  182.          <p> := IIF( <p> == Nil, <val>, <p> );     ;
  183.          [ <pn> := IIF( <pn> == Nil, <valn>, <pn> ) ]
  184.  
  185. *------------------------------------------------
  186. //  Demo of FT_ClrSel()
  187.  
  188. /*
  189.  *     To run the sample program:
  190.  *
  191.  *     Compile :   Clipper ClrSel /n /m /w /dFT_TEST
  192.  *     Link    :   Rtlink FILE ClrSel LIB NanFor [/PLL:Fullbase]
  193.  *                                         .OR.  [/PLL:Base50]
  194.  *
  195.  *     ClrSel MONO      To force monochrome mode
  196.  *     ClrSel NOSNOW    To prevent CGA snowstorms
  197.  *     ClrSel EGA       43 line mode
  198.  *     ClrSel VGA       50 line mode
  199.  *
  200.  */
  201.  
  202. #IFDEF FT_TEST
  203.  
  204.   FUNCTION Main( cVidMode )
  205.  
  206.   LOCAL nRowDos := ROW()
  207.   LOCAL nColDos := COL()
  208.   LOCAL lBlink  := SETBLINK( .F. )  // make sure it starts out .F.
  209.   LOCAL aEnvDos := FT_SaveSets()
  210.   LOCAL cScrDos := SAVESCREEN( 00, 00, MAXROW(), MAXCOL() )
  211.   LOCAL lColour := .F.
  212.   LOCAL aClrs   := {}
  213.   
  214.   DEFAULT cVidMode TO ""
  215.   NOSNOW( ( "NOSNOW" $ UPPER( cVidMode ) ) )
  216.   IF "VGA" $ UPPER( cVidMode )
  217.      SETMODE( 50, 80 )
  218.   ENDIF
  219.   IF "EGA" $ UPPER( cVidMode )
  220.      SETMODE( 43, 80 )
  221.   ENDIF
  222.   lColour := IF( "MONO" $ UPPER( cVidMode ), .F., ISCOLOR() )
  223.  
  224.   SET SCOREBOARD Off
  225.   SETCURSOR( SC_NONE )
  226.   lBlink := SETBLINK( .F. )
  227.  
  228.   *.... a typical application might have the following different settings
  229.   *     normally these would be stored in a .dbf/.dbv
  230.   aClrs := {;
  231.      { "Desktop",        "N/BG",                         "D", "▒" }, ;
  232.      { "Title",          "N/W",